Imports System
Imports System.IO
Imports System.Reflection

Imports System.Text
Imports System.Web
Imports System.Web.Hosting

Imports System.Runtime.Remoting
Imports System.Runtime.Remoting.Lifetime
Imports System.Collections
Imports System.Collections.Specialized


'/// <summary>
'/// A subclass of SimpleWorkerRequest that allows to push data to the ASP.Net request
'/// via the Context object.
'/// </summary>
Public Class wwWorkerRequest
    Inherits SimpleWorkerRequest


    '/// <summary>
    '/// Optional parameter data sent to the ASP.Net page. This value is stored into the 
    '/// Context object as Context["Content"]. Only a single parameter can be passed,
    '/// but you can pass an object that contains additional properties.
    '/// Objects passed must be serializable or inherit from MarshalByRefObject.
    '/// </summary>
    Public ParameterData As Object = Nothing

    '/// <summary>
    '/// Contains a set of parameters
    '/// </summary>
    Public Context As Hashtable = New Hashtable()

    '/// <summary>
    '/// Returns optional Response data that is retrieved from the Context object
    '/// via the Context["ResultContent"] key.
    '/// </summary>
    Public ResponseData As Object = Nothing

    '/// <summary>
    '/// Optional PostBuffer that allows sending Postable data to the ASPX page.
    '/// </summary>
    Public PostData As Byte() = Nothing

    '/// <summary>
    '/// The content type for the POST operation. Defaults to application/x-www-form-urlencoded.
    '/// </summary>
    Public PostContentType As String = "application/x-www-form-urlencoded"


    '/// <summary>
    '/// Hashtable that contains the server headers as header/value pairs
    '/// </summary>
    Public ResponseHeaders As Hashtable = New Hashtable()

    '/// <summary>
    '/// Collection that captures all the cookies in the request
    '/// </summary>
    Public Cookies As Hashtable = Nothing

    '/// <summary>
    '/// Pass in a set of request headers as Header / Value pairs
    '/// </summary>
    Public RequestHeaders As Hashtable = Nothing

    '/// <summary>
    '/// Numeric Server Response Code
    '/// </summary>
    Public ResponseStatusCode As Int32

    '/// <summary>
    '/// The physical path for this application
    '/// </summary>
    Public PhysicalPath As String = ""


    '/// <summary>
    '/// Internal property used to keep track of the HTTP Context object.
    '/// Used to retrieve the Context.Item["ResultContent"] value
    '/// </summary>
    Private CurrentContext As HttpContext = Nothing


    Private Page As String = ""
    Private QueryString As String = ""


    '/// <summary>
    '/// Callback to basic constructor
    '/// </summary>
    '/// <param name="Page">Name of the page to execute in the Web app. Must be in the VRoot defined for the app with the app host.</param>
    '/// <param name="QueryString">Optional QueryString. Pass null if no query string data.</param>
    '/// <param name="Output">TextWriter object that receives the output from the request.</param>
    Public Sub New(ByVal Page As String, ByVal QueryString As String, ByVal Output As TextWriter)
        MyBase.new(Page, QueryString, Output)

        Me.Page = Page
        Me.QueryString = QueryString
    End Sub

    '/// <summary>
    '/// Returns the physical Path
    '/// </summary>
    '/// <returns></returns>
    Public Overrides Function GetAppPathTranslated() As String

        Return Me.PhysicalPath
    End Function

    '/// <summary>
    '/// Returns the logical path for the application
    '/// /localscript/sub/test.aspx
    '/// </summary>
    '/// <returns></returns>
    Public Overrides Function GetFilePath() As String

        '// *** Default Behavior doesn't work for URL formatting
        '// string FilePath = base.GetFilePath()

        Dim FilePath As String

        Dim Path As String = Me.GetAppPath()
        If (Path = "/") Then

            FilePath = "/" + Me.Page.Replace("\\", "/")
        Else

            FilePath = Path + "/" + Me.Page
            FilePath = FilePath.Replace("\\", "/")

        End If
        FilePath = FilePath.Replace("//", "/")
        Return FilePath
    End Function

    '/// <summary>
    '/// Need to override the Pysical File Mapping Services
    '/// </summary>
    '/// <returns></returns>
    Public Overrides Function GetFilePathTranslated() As String

        Dim NewPath As String = Me.PhysicalPath + Me.Page.Replace("/", "\\")
        Return NewPath.Replace("\\", "\")
    End Function



    '/// <summary>
    '/// Method that is called just before the ASP.Net page gets executed. Allows
    '/// setting of the Context object item collection with arbitrary data. Also saves
    '/// the Context object so it can be used later to retrieve any result data.
    '/// Inbound: Context.Items["Content"] (Parameter data)
    '///          OR: you can add Context items directly by name and pick them up by name
    '/// Outbound: Context.Items["ResultContent"]
    '/// </summary>
    '/// <param name="callback">callback delegate</param>
    '/// <param name="extraData">extraData for system purpose</param>
    Public Overrides Sub SetEndOfSendNotification(ByVal callback As EndOfSendNotification, ByVal extraData As Object)

        MyBase.SetEndOfSendNotification(callback, extraData)

        Me.CurrentContext = CType(extraData, HttpContext)

        If Not (Me.ParameterData Is Nothing) Then

            ' /// *** Use 'as' instead of cast to ensure additional calls don't throw exceptions

            If Not (Me.CurrentContext Is Nothing) Then

                ' /// *** Add any extra data here to the 
                Me.CurrentContext.Items.Add("Content", Me.ParameterData)
            End If
        End If

        '// *** Copy inbound context data
        If Not (Me.Context Is Nothing) Then

            For Each Item As Object In Me.Context.Keys
                Me.CurrentContext.Items.Add(Item, Me.Context(Item))
            Next
        End If

    End Sub


    '// *** the following three methods are overridden to provide the
    '// *** ability to POST information to the Web Server

    '/// <summary>
    '/// We must send the Verb so the server knows that it's a POST request.
    '/// </summary>
    '/// <returns></returns>
    Public Overrides Function GetHttpVerbName() As String

        If (Me.PostData Is Nothing) Then
            Return MyBase.GetHttpVerbName()
        End If
        Return "POST"
    End Function

    '/// <summary>
    '/// We must override this method to send the ContentType to the client
    '/// when POSTing so that the request is recognized as a POST.
    '/// </summary>
    '/// <param name="index"></param>
    '/// <returns></returns>
    Public Overrides Function GetKnownRequestHeader(ByVal index As Integer) As String

        If (index = HttpWorkerRequest.HeaderContentLength) Then

            If Not (Me.PostData Is Nothing) Then
                Return Me.PostData.Length.ToString()
            End If
        ElseIf (index = HttpWorkerRequest.HeaderContentType) Then

            If Not (Me.PostData Is Nothing) Then
                Return Me.PostContentType
            End If


        Else

            '// *** if we need to pass headers write them out
            If Not (Me.RequestHeaders Is Nothing) Then

                Dim header As String = HttpWorkerRequest.GetKnownRequestHeaderName(index)
                If Not (header Is Nothing) Then

                    header = header.ToLower()
                    If (Me.RequestHeaders.Contains(header)) Then
                        Return CType(RequestHeaders(header), String)
                    End If
                End If
            End If
        End If
        Return "" ' //base.GetKnownRequestHeader(index)
    End Function

    '/// <summary>
    '/// Return any POST data if provided
    '/// </summary>
    '/// <returns></returns>
    Public Overrides Function GetPreloadedEntityBody() As Byte()

        If Not (Me.PostData Is Nothing) Then
            Return Me.PostData
        End If

        Return MyBase.GetPreloadedEntityBody()
    End Function

    '/// <summary>
    '/// Set the internal status code we can pick up
    '/// Pick up ResultContent Content variable 
    '/// </summary>
    '/// <param name="statusCode"></param>
    '/// <param name="statusDescription"></param>
    Public Overloads Sub SendStatus(ByVal statusCode As Integer, ByVal statusDescription As Integer)

        If Me.CurrentContext Is Nothing Then

            Me.ResponseData = Me.CurrentContext.Items("ResultContent")

        End If
        ' // *** Copy outbound Context
        If (Me.CurrentContext.Items.Count > 0) Then

            Me.Context.Clear()
            For Each Key As Object In Me.CurrentContext.Items.Keys
                Me.Context.Add(Key, Me.CurrentContext.Items(Key))
            Next

        End If

        Me.ResponseStatusCode = statusCode
        MyBase.SendStatus(statusCode, statusDescription)
    End Sub

    '/// <summary>
    '/// Retrieve Response Headers and store in ResponseHeaders() collection
    '/// so we can simulate them from the browser.
    '/// </summary>
    '/// <param name="index"></param>
    '/// <param name="value"></param>
    Public Overloads Sub SendKnownResponseHeader(ByVal index As Integer, ByVal value As String)

        Dim header As String = HttpWorkerRequest.GetKnownResponseHeaderName(index).ToLower()
        Select Case index


            Case HttpWorkerRequest.HeaderSetCookie

                If (Me.Cookies Is Nothing) Then
                    Me.Cookies = New Hashtable()
                End If


                Dim CookieName As String = value.Substring(0, value.IndexOf("=")).ToLower()
                If Not (Cookies.Contains(CookieName)) Then
                    Cookies.Add(CookieName, value)
                Else
                    Cookies(CookieName) = value
                End If
                'exit 

            Case Else

                Try
                    ResponseHeaders.Add(header, value)
                Catch
                    Dim name As String = header
                End Try


        End Select

        MyBase.SendKnownResponseHeader(index, value)
    End Sub

    '/// <summary>
    '/// Store custom headers to ResponseHeaders Hashtable collection
    '/// </summary>
    '/// <param name="name"></param>
    '/// <param name="value"></param>
    Public Overloads Sub SendUnknownResponseHeader(ByVal name As String, ByVal value As String)

        ResponseHeaders.Add(name, value)
        MyBase.SendUnknownResponseHeader(name, value)
    End Sub


End Class





